home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Developer Essentials / DTS Sample Code / Macintosh Sample Code / SC.012.Signals / TestSignal.p < prev    next >
Encoding:
Text File  |  1988-10-31  |  2.9 KB  |  134 lines  |  [TEXT/MPS ]
  1. {------------------------------------------------------------------------------
  2. #
  3. #    Apple Macintosh Developer Technical Support
  4. #
  5. #    Exception handling for MPW Pascal, MacApp and MPW C
  6. #
  7. #    UFailure (aka Signals) - “Exceptional code, with a few exceptions.”
  8. #
  9. #    TestCignal.p    -    Test tool for Pascal access to enhanced UFailure
  10. #
  11. #    Copyright © 1985-1988 Apple Computer, Inc.
  12. #    All rights reserved.
  13. #
  14. #    Versions:    1.0                    11/88
  15. #
  16. #    Components:    UFailure.p            November 1, 1988
  17. #                UFailure.h            November 1, 1988
  18. #                UFailure.inc1.p        November 1, 1988
  19. #                UFailure.a            November 1, 1988
  20. #                TestCignal.c        November 1, 1988
  21. #                TestCignal.make        November 1, 1988
  22. #                TestSignal.p        November 1, 1988
  23. #                TestSignal.make        November 1, 1988
  24. #
  25. #    UFailure (or Signals) is a set of exception handling routines suitable for
  26. #    use with MacApp, MPW C, and MPW Pascal. It is a jazzed-up version of the MacApp
  27. #    UFailure unit. There is a set of C interfaces to it as well.
  28. #
  29. ------------------------------------------------------------------------------}
  30.  
  31. Program TestSignals;
  32.  
  33. USES
  34.     MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf,
  35.     UFailure;
  36. {$D+}
  37.  
  38.  
  39. PROCEDURE DoCatchOutMain(s:STRING; long:LONGINT);
  40. BEGIN
  41.     Writeln(s, long:2);
  42.     Exit(TestSignals);
  43. END; {DoCatchOutMain}
  44.  
  45.         
  46.  
  47.  
  48. FUNCTION Value:LONGINT;
  49.     VAR
  50.         code:    INTEGER;
  51.         
  52.     PROCEDURE Never;
  53.         VAR
  54.             code:    INTEGER;
  55.             fi:        FailInfo;
  56.     
  57.         PROCEDURE Handler(code: INTEGER; message: LONGINT);
  58.             BEGIN
  59.                 Writeln('Handler from Never; message = ',message:2,', code = ',code:2);
  60.                 {this will do an implicit Failure() when it exits}
  61.             END;
  62.  
  63.         BEGIN {Never}
  64.             CatchFailures(fi, Handler);
  65.     
  66.             code := CatchSignal;
  67.             IF code <> 0 THEN BEGIN
  68.                 Writeln('Never shouldn’t get here; code=', code:2);
  69.                 Value := code;
  70.                 Exit(Never);
  71.             END;
  72.         
  73.             FreeSignal; {"free" the last CatchSignal}
  74.             
  75.             SignalMessage(7, 77777); {Signal a 7 to the last Catch (in this case}
  76.         END;{Never}
  77.  
  78.  
  79.     PROCEDURE Failer;
  80.         BEGIN
  81.             IF CatchSignal = 0 THEN
  82.                 Never;
  83.             
  84.             Failure(69, 0);            {fail no matter what}
  85.         END; {Failer}
  86.         
  87.     BEGIN {Value}
  88.         code := CatchSignal;
  89.         IF code <> 0 THEN BEGIN
  90.             Writeln('Shouldn’t be here in Value, code=', code:2);
  91.             Value := code;
  92.             Exit(Value);
  93.         END;
  94.         
  95.         {when this does its return the CatchSignal above will be automatically popped}
  96.         code := CatchSignal;
  97.         IF code <> 0 THEN BEGIN
  98.             Value := code;
  99.             Exit(Value);
  100.         END;
  101.         
  102.         Failer;
  103.     END;{Value}
  104.  
  105. PROCEDURE Main;
  106.     
  107.     VAR
  108.         aString:        Str255;
  109.         code:            INTEGER;
  110.         registerLong:    LONGINT;
  111.  
  112.     BEGIN
  113.  
  114.         registerLong := 0;
  115.         
  116.         {catch Signals not otherwise caught by the program}
  117.         code := CatchSignal;
  118.         IF code <> 0 THEN BEGIN
  119.             NumToString(code, aString);
  120.             aString := Concat('Signal caught from main, code = ',aString,
  121.                 ', registerLong = ');
  122.             DoCatchOutMain(aString, registerLong);
  123.         END;
  124.         
  125.         registerLong := $FFFF;
  126.         
  127.         Signal(Value);
  128.     END; {Main}
  129.     
  130. BEGIN {PROGRAM}
  131.     InitSignals; {Call this with other (i.e. toolbox) inits}
  132.     Main;
  133. END.
  134.